home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
HyperCard Dev. ToolKit
/
Video.Drivers
/
PioneerLDV6000.p
< prev
next >
Wrap
Text File
|
1987-08-17
|
7KB
|
299 lines
{$R-}
{$D+}
(*
Pioneer-LD-V6000 -- a HyperCard user-defined command
to drive a laser disc player.
©Apple Computer, Inc. 1987
All Rights Reserved.
To compile and link this file using Macintosh Programmer's Workshop
(HyperXCmd.p and XCmdGlue.inc must be accessible).
pascal -w PioneerLDV6000.p
link -m ENTRYPOINT -o HyperCommands -rt XCMD=14 -sn Main=PioneerLDV6000 ∂
PioneerLDV6000.p.o "{MPW}"Libraries:interface.o
then use ResEdit to copy the resulting XCMD from HyperCommands
and paste it into the Home stack, or your own stack.
(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
*)
{$S PioneerLDV6000 } { Segment name must be the same as the command name. }
UNIT DummyUnit;
INTERFACE
USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
IMPLEMENTATION
TYPE Str19 = String[19];
Str31 = String[31];
PROCEDURE PioneerLDV6000(paramPtr: XCmdPtr); FORWARD;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
{ entry point cannot have local procs, but forward routines can }
BEGIN
PioneerLDV6000(paramPtr);
END;
PROCEDURE PioneerLDV6000(paramPtr: XCmdPtr);
VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
tempStr: Str255;
refNum: INTEGER;
err: INTEGER;
params: ARRAY[1..32] OF Str19;
{$I XCmdGlue.inc }
PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
BEGIN
paramPtr^.returnValue := PasToZero(errMsg);
EXIT(PioneerLDV6000);
END;
PROCEDURE OpenSerial;
VAR handShake: SerShk;
baudRate: INTEGER;
BEGIN
baudRate := 9600;
{ for now, use modem port so we don't mess with AppleTalk }
err := FSOpen('.AOUT',0,refNum);
IF err = 0 THEN
BEGIN
WITH handShake DO
BEGIN
fXon := 1;
fCTS := 1;
xon := CHR(17);
xoff := CHR(19);
errs := 0;
evts := 0;
fInx := 0;
END;
err := SerHShake(refNum,handShake);
IF err = 0 THEN
err := Control(refNum,13,@baudRate);
END;
END;
PROCEDURE CloseSerial;
BEGIN
err := FSClose(refNum);
END;
PROCEDURE SendCommand(cmd: Str255);
VAR count: LongInt;
BEGIN
count := Length(cmd);
err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
END;
FUNCTION Concat(str1, str2, str3: Str255): Str255;
VAR result: Str255;
resultLen: INTEGER;
charNum: INTEGER;
BEGIN
result := '';
resultLen := 0;
FOR charNum := 1 TO Length(str1) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str1[charNum];
END;
FOR charNum := 1 TO Length(str2) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str2[charNum];
END;
FOR charNum := 1 TO Length(str3) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str3[charNum];
END;
result[0] := CHR(resultLen);
Concat := result;
END;
PROCEDURE GetMessage;
VAR paramNum, charNum: INTEGER;
msgChar: CHAR;
BEGIN
{ convert params to pascal strings }
FOR paramNum := 1 TO paramPtr^.paramCount DO
BEGIN
tempStr := params[paramNum];
ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
{ force all chars to lower case }
FOR charNum := 1 TO Length(tempStr) DO
BEGIN
msgChar := tempStr[charNum];
IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
END;
params[paramNum] := tempStr;
END;
END;
FUNCTION Contains(target: Str255): BOOLEAN;
VAR offset: INTEGER;
FUNCTION Match(which: INTEGER): BOOLEAN;
VAR index: INTEGER;
BEGIN
Match := TRUE;
FOR index := 1 TO Length(target) DO
IF index > Length(params[which]) THEN
BEGIN
Match := FALSE; { ran off the end }
EXIT(Match);
END
ELSE IF target[index] <> params[which][index] THEN
BEGIN
Match := FALSE; { hit a wrong char }
EXIT(Match);
END;
END;
BEGIN
Contains := FALSE;
FOR offset := 1 TO paramPtr^.paramCount DO
IF Match(offset) THEN
BEGIN
Contains := TRUE;
EXIT(Contains);
END;
END;
FUNCTION GetDigit(digit: CHAR): Str255;
BEGIN
CASE digit OF
'0': GetDigit := '3F';
'1': GetDigit := '0F';
'2': GetDigit := '8F';
'3': GetDigit := '4F';
'4': GetDigit := '2F';
'5': GetDigit := 'AF';
'6': GetDigit := '6F';
'7': GetDigit := '1F';
'8': GetDigit := '9F';
'9': GetDigit := '5F';
END;
END;
FUNCTION GetInteger: Str255;
{ get an integer in Pioneer format }
VAR which, digitLoc, charVal: INTEGER;
intStr: Str255;
BEGIN
intStr := '';
FOR which := 1 TO paramPtr^.paramCount DO
BEGIN
charVal := ORD(params[which][1]);
IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
BEGIN
FOR digitLoc := 1 TO Length(params[which]) DO
intStr := Concat(intStr, GetDigit(params[which][digitLoc]),'');
GetInteger := intStr;
exit(GetInteger);
END;
END;
GetInteger := intStr; { just in case }
END;
BEGIN
OpenSerial;
IF err <> 0 THEN
BEGIN
SysBeep(1);
Fail('Could not open serial port');
END;
GetMessage;
{ set flags }
reverseFlag := Contains('rev');
offFlag := Contains('off');
tillFlag := Contains('till');
IF Contains('stop') THEN SendCommand('@FB')
ELSE IF Contains('eject') THEN SendCommand('@F9')
ELSE IF Contains('search') THEN SendCommand(Concat('@', GetInteger, 'F7'))
ELSE IF Contains('step') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('@F6') {step fwd}
ELSE SendCommand('@FE') {step rev}
END
ELSE IF Contains('play') THEN
BEGIN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('@FD') {play fwd}
ELSE SendCommand('@0FECFA'); {play rev}
END
ELSE SendCommand(Concat('@', GetInteger, 'F3')) {play till}
END
ELSE IF Contains('slow') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('@4FEDF2') {slow fwd}
ELSE SendCommand('@4FEDFA') {slow rev}
END
ELSE IF Contains('fast') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('@4FECF2') {fast fwd}
ELSE SendCommand('@4FECFA') {fast rev}
END
ELSE IF Contains('scan') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('@4FECF2') {scan fwd}
ELSE SendCommand('@4FECFA') {scan rev}
END
ELSE IF Contains('picture') THEN
BEGIN
IF NOT offFlag THEN SendCommand('@1B') {picture on}
ELSE SendCommand('@1C') {picture off}
END
ELSE IF Contains('frame') THEN
BEGIN
IF NOT offFlag THEN SendCommand('@0FF1') {frame on}
ELSE SendCommand('@3FF1') {frame off}
END
ELSE IF Contains('sound') THEN
BEGIN
IF Contains('1') THEN
IF NOT offFlag THEN SendCommand('@0FF4') {sound 1 on}
ELSE SendCommand('@3FF4') {sound 1 off}
ELSE IF Contains('2') THEN
IF NOT offFlag THEN SendCommand('@0FFC') {sound 2 on}
ELSE SendCommand('@3FFC') {sound 2 off}
ELSE
BEGIN
CloseSerial;
Fail('Unknown video sound channel');
END;
END
ELSE IF NOT Contains('init') THEN { init does nothing for this player }
BEGIN
CloseSerial;
SysBeep(1);
Fail('Unknown video command');
END;
CloseSerial;
END;
END.